home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / prim / dialog.el < prev    next >
Encoding:
Text File  |  1995-06-30  |  3.2 KB  |  77 lines
  1. ;; Dialog-box support.
  2. ;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of XEmacs.
  5.  
  6. ;; XEmacs is free software; you can redistribute it and/or modify it
  7. ;; under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 2, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; XEmacs is distributed in the hope that it will be useful, but
  12. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14. ;; General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  18. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (defun yes-or-no-p-dialog-box (prompt)
  21.   "Ask user a \"y or n\" question with a popup dialog box.
  22. Returns t if answer is \"yes\".
  23. Takes one argument, which is the string to display to ask the question."
  24.   (let ((echo-keystrokes 0)
  25.     event)     
  26.     (popup-dialog-box
  27.      ;; "Non-violent language please!" says Robin.
  28.      (cons prompt '(["Yes" yes t] ["No" no t] nil ["Cancel" abort t])))
  29. ;     (cons prompt '(["Yes" yes t] ["No" no t] nil ["Abort" abort t])))
  30.     (catch 'ynp-done
  31.       (while t
  32.     (setq event (next-command-event event))
  33.     (cond ((and (misc-user-event-p event) (eq (event-object event) 'yes))
  34.            (throw 'ynp-done t))
  35.           ((and (misc-user-event-p event) (eq (event-object event) 'no))
  36.            (throw 'ynp-done nil))
  37.           ((and (misc-user-event-p event)
  38.             (or (eq (event-object event) 'abort)
  39.             (eq (event-object event) 'menu-no-selection-hook)))
  40.            (signal 'quit nil))
  41.           ((button-release-event-p event) ;; don't beep twice
  42.            nil)
  43.           (t
  44.            (beep)
  45.            (message "please answer the dialog box")))))))
  46.  
  47. (defun yes-or-no-p-maybe-dialog-box (prompt)
  48.   "Ask user a yes-or-no question.  Return t if answer is yes.
  49. The question is asked with a dialog box or the minibuffer, as appropriate.
  50. Takes one argument, which is the string to display to ask the question.
  51. It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.
  52. The user must confirm the answer with RET,
  53. and can edit it until it as been confirmed."
  54.   (if (or (button-press-event-p last-command-event)
  55.       (button-release-event-p last-command-event)
  56.       (misc-user-event-p last-command-event))
  57.       (yes-or-no-p-dialog-box prompt)
  58.     (yes-or-no-p-minibuf prompt)))
  59.  
  60. (defun y-or-n-p-maybe-dialog-box (prompt)
  61.   "Ask user a \"y or n\" question.  Return t if answer is \"y\".
  62. Takes one argument, which is the string to display to ask the question.
  63. The question is asked with a dialog box or the minibuffer, as appropriate.
  64. It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
  65. No confirmation of the answer is requested; a single character is enough.
  66. Also accepts Space to mean yes, or Delete to mean no."
  67.   (if (or (button-press-event-p last-command-event)
  68.       (button-release-event-p last-command-event)
  69.       (misc-user-event-p last-command-event))
  70.       (yes-or-no-p-dialog-box prompt)
  71.     (y-or-n-p-minibuf prompt)))
  72.  
  73. (if (fboundp 'popup-dialog-box)
  74.     (progn
  75.       (fset 'yes-or-no-p 'yes-or-no-p-maybe-dialog-box)
  76.       (fset 'y-or-n-p 'y-or-n-p-maybe-dialog-box)))
  77.